home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…ch: Other People's Memory / ADC Developer CD (1993-03) (''Other People's Memory'')_iso / Dev.CD Mar 93.iso / Development Platforms / LISP Related / LISP Goodies / AV Parser / AV Program / scrollers-patch.lisp < prev   
Encoding:
Text File  |  1992-09-02  |  2.5 KB  |  66 lines  |  [TEXT/CCL2]
  1. ;;; scrollers-patch.lisp
  2. ;;;
  3. ;;; Patch file and bug fixes for scrollers.lisp
  4. ;;;
  5.  
  6. (in-package :ccl)
  7.  
  8. (require :scrollers)
  9.  
  10. ;; The method in scrollers.lisp doesn't subtract the window size from the field
  11. ;; size. This method does.
  12.  
  13. (defmethod scroll-bar-limits ((view scroller-mixin))
  14.   (let ((field-size (field-size view)))
  15.     (if field-size
  16.       (normal-scroll-bar-limits view field-size)
  17.       (let ((size (view-size view)))
  18.         (normal-scroll-bar-limits view (add-points size size))))))
  19.  
  20. ;; The method in scrollers.lisp doesn't inform scroll-bar-changed if
  21. ;; the scroll-bar-setting changes when the scroll-bars are updated.
  22. ;; This method does.
  23.  
  24. (defmethod update-scroll-bars ((self scroller-mixin) &key length position)
  25.   (flet ((set-settings (scroller min max page-size)
  26.            (let ((setting (scroll-bar-setting scroller)))
  27.              (set-scroll-bar-min scroller min)
  28.              (set-scroll-bar-max scroller max)
  29.              (setf (scroll-bar-page-size scroller) page-size)
  30.              (when (and (view-container self) 
  31.                         (not (< min setting max)))
  32.                (scroll-bar-changed self scroller)))))
  33.     (let* ((pos (view-position self))
  34.            (size (view-size self))
  35.            (h-scroller (h-scroller self))
  36.            (v-scroller (v-scroller self))
  37.            (outline (scroller-outline self))
  38.            h-limits v-limits page-size)
  39.       (when (and pos size)                ; auto-sizing may not have happenned yet 
  40.         (without-interrupts
  41.          (reposition-scroll-bars self h-scroller v-scroller :length length :position position)
  42.          (when length
  43.            (multiple-value-setq (h-limits v-limits) (scroll-bar-limits self))
  44.            (setq page-size (scroll-bar-page-size self))
  45.            (when  h-scroller
  46.              (set-settings h-scroller (point-h h-limits) (point-v h-limits) (point-h page-size)))
  47.            (when v-scroller
  48.              (set-settings v-scroller (point-h v-limits) (point-v v-limits) (point-v page-size))))
  49.          (when outline
  50.            (setq pos (subtract-points pos #@(1 1))
  51.                  size (add-points size (scroll-bar-correction self)))
  52.            (set-view-position outline pos)
  53.            (set-view-size outline size)))))))
  54.  
  55. ;; enhancement to scrollers.lisp
  56.  
  57. (defmethod set-field-size ((view scroller-mixin) h &optional v)
  58.   "Adjust the field size of a scroller-mixin by setting the field-size slot
  59. and resizing the scroll bars"
  60.   (setf (slot-value view 'field-size) (make-point h v))
  61.   (update-scroll-bars view :length t))
  62.  
  63. (provide :scrollers-patch)
  64.  
  65.  
  66.